home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / src / facility.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-17  |  2.4 KB  |  116 lines
  1. /*
  2.  * This file is part of the portable Forth environment written in ANSI C.
  3.  * Copyright (C) 1995  Dirk Uwe Zoller
  4.  *
  5.  * This library is free software; you can redistribute it and/or
  6.  * modify it under the terms of the GNU Library General Public
  7.  * License as published by the Free Software Foundation; either
  8.  * version 2 of the License, or (at your option) any later version.
  9.  *
  10.  * This library is distributed in the hope that it will be useful,
  11.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  * See the GNU Library General Public License for more details.
  14.  *
  15.  * You should have received a copy of the GNU Library General Public
  16.  * License along with this library; if not, write to the Free
  17.  * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  *
  19.  * This file is version 0.9.13 of 17-July-95
  20.  * Check for the latest version of this package via anonymous ftp at
  21.  *    roxi.rz.fht-mannheim.de:/pub/languages/forth/pfe-VERSION.tar.gz
  22.  * or    sunsite.unc.edu:/pub/languages/forth/pfe-VERSION.tar.gz
  23.  * or    ftp.cygnus.com:/pub/forth/pfe-VERSION.tar.gz
  24.  *
  25.  * Please direct any comments via internet to
  26.  *    duz@roxi.rz.fht-mannheim.de.
  27.  * Thank You.
  28.  */
  29. /*
  30.  * facility.c ---     The Optional Facility Word Set
  31.  * (duz 13Jul93)
  32.  */
  33.  
  34. #include "forth.h"
  35. #include "support.h"
  36. #include "term.h"
  37.  
  38. #include <time.h>
  39.  
  40. #include "missing.h"
  41.  
  42. Code (at_x_y)
  43. {
  44.   c_gotoxy (sp[1], sp[0]);
  45.   sp += 2;
  46. }
  47.  
  48. code (key_question)
  49. {
  50.   *--sp = FLAG (c_keypressed ());
  51. }
  52.  
  53. Code (page)
  54. {
  55.   c_clrscr ();
  56. }
  57.  
  58. /* Facility Extension Words */
  59.  
  60. Code (ekey)
  61. {
  62.   *--sp = (Cell) getekey ();
  63. }
  64.  
  65. Code (ekey_to_char)
  66. {
  67.   --sp;
  68.   sp[0] = FLAG ((uCell) sp[1] < 0x100);
  69. }
  70.  
  71. Code (ekey_question)
  72. {
  73.   *--sp = FLAG (ekeypressed ());
  74. }
  75.  
  76. Code (emit_question)
  77. {
  78.   *--sp = TRUE;
  79. }
  80.  
  81. Code (ms)
  82. {
  83.   millisec (*sp++);
  84. }
  85.  
  86. Code (time_and_date)
  87. {
  88.   time_t t;
  89.   struct tm *tm;
  90.  
  91.   time (&t);
  92.   tm = localtime (&t);
  93.   sp -= 6;
  94.   sp[5] = tm->tm_sec;
  95.   sp[4] = tm->tm_min;
  96.   sp[3] = tm->tm_hour;
  97.   sp[2] = tm->tm_mday;
  98.   sp[1] = tm->tm_mon + 1;
  99.   sp[0] = tm->tm_year + 1900;
  100. }
  101.  
  102. /* *INDENT-OFF* */
  103. LISTWORDS (facility) =
  104. {
  105.   CO ("AT-XY",        at_x_y),
  106.   CO ("KEY?",        key_question),
  107.   CO ("PAGE",        page),
  108.   CO ("EKEY",        ekey),
  109.   CO ("EKEY>CHAR",    ekey_to_char),
  110.   CO ("EKEY?",        ekey_question),
  111.   CO ("EMIT?",        emit_question),
  112.   CO ("MS",        ms),
  113.   CO ("TIME&DATE",    time_and_date)
  114. };
  115. COUNTWORDS (facility, "Facility + extensions");
  116.